home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / dev / lang / bcpl4amiga.lha / bcpl / syn.bpl < prev    next >
Text File  |  1991-01-25  |  29KB  |  1,083 lines
  1. //    MASTER
  2.  
  3. GET "LIBHDR"
  4.  
  5. GLOBAL $(
  6. CHBUF:100; PRSOURCE:110
  7. PPTRACE:127; OPTION:128
  8. FORMTREE:150; PLIST:152
  9. TREEP:167; TREEVEC:168
  10. CHARCODE:190; REPORTCOUNT:191; REPORTMAX:192
  11. SOURCESTREAM:193; SYSPRINT:194; OCODE:195
  12. COMPILEAE:245
  13. SAVESPACESIZE:282
  14. $)
  15.  
  16. LET CHARCODE(CH) = CH  // THE DEFAULT SETTING OF CHARCODE
  17.  
  18. AND EBCDICTOASCII(CH) = CH!TABLE
  19.       0,   0,   0,   0,   0, #11,   0,   0,
  20.       0,   0,   0, #13, #14, #15,   0,   0,
  21.       0,   0,   0,   0,   0, #12,   0,   0,
  22.       0,   0,   0,   0,   0,   0,   0,   0,
  23.       0,   0,   0,   0,   0, #12,   0,   0,
  24.       0,   0,   0,   0,   0,   0,   0,   0,
  25.       0,   0,   0,   0,   0,   0,   0,   0,
  26.       0,   0,   0,   0,   0,   0,   0,   0,
  27.     #40,   0,#133,#135,   0,   0,   0,   0,
  28.       0,   0,   0, #56, #74, #50, #53,#174,
  29.     #46,   0,   0,   0,   0,   0,   0,   0,
  30.       0,   0, #41, #44, #52, #51, #73,#176,
  31.     #55, #57,#134,   0,   0,#136,#137,   0,
  32.       0,   0,   0, #54, #45,#140, #76, #77,
  33.       0,   0,   0,   0,   0,   0,   0,   0,
  34.       0,   0, #72, #43,#100, #47, #75, #42,
  35.       0,#141,#142,#143,#144,#145,#146,#147,
  36.    #150,#151,   0,   0,   0,   0,   0,   0,
  37.       0,#152,#153,#154,#155,#156,#157,#160,
  38.    #161,#162,   0,   0,   0,   0,   0,   0,
  39.       0,   0,#163,#164,#165,#166,#167,#170,
  40.    #171,#172,   0,   0,   0,   0,   0,   0,
  41.       0,   0,   0,   0,   0,   0,   0,   0,
  42.       0,   0,   0,   0,   0,   0,   0,   0,
  43.       0,#101,#102,#103,#104,#105,#106,#107,
  44.    #110,#111,   0,   0,   0,   0,   0,   0,
  45.       0,#112,#113,#114,#115,#116,#117,#120,
  46.    #121,#122,   0,   0,   0,   0,   0,   0,
  47.       0,   0,#123,#124,#125,#126,#127,#130,
  48.    #131,#132,   0,   0,   0,   0,   0,   0,
  49.     #60, #61, #62, #63, #64, #65, #66, #67,
  50.     #70, #71,   0,   0,   0,   0,   0,   0
  51. LET START(PARM) BE
  52. $(1
  53. SYSPRINT := FINDOUTPUT("SYSPRINT")
  54. SELECTOUTPUT(SYSPRINT)
  55.  
  56. WRITEF("*NBCPL %N*N", @START)
  57.  
  58. $( LET OPT = VEC 20
  59.    AND TREESIZE = 5500
  60.    OPTION := OPT
  61.    SAVESPACESIZE := 2
  62.    PPTRACE := FALSE
  63.    PRSOURCE := FALSE
  64.    FOR I = 0 TO 20 DO OPT!I := FALSE
  65.  
  66. SOURCESTREAM := FINDINPUT("OPTIONS")
  67.  
  68. UNLESS SOURCESTREAM=0 DO
  69. $(P LET CH = 0
  70.     AND N = 0
  71.     SELECTINPUT(SOURCESTREAM)
  72.     WRITES("OPTIONS  ")
  73.  
  74.     $( CH := RDCH()
  75.     L: IF CH='*N' \/ CH=ENDSTREAMCH BREAK
  76.        WRCH(CH)
  77.        IF CH='P' DO N := 1
  78.        IF CH='T' DO N := 2
  79.        IF CH='C' DO N := 3
  80.        IF CH='M' DO N := 4
  81.        IF CH='N' DO N := 5
  82.        IF CH='A' DO CHARCODE := EBCDICTOASCII
  83.        IF CH='S' DO PRSOURCE := TRUE
  84.        IF CH='E' DO PPTRACE := TRUE
  85.        IF CH='L' DO  $( TREESIZE := READN()
  86.                         WRITEN(TREESIZE)
  87.                         CH := TERMINATOR
  88.                         GOTO L  $)
  89.        IF CH='3' DO SAVESPACESIZE := 3
  90.        OPTION!N := TRUE
  91.                  $) REPEAT
  92.  
  93.     NEWLINE()
  94.     ENDREAD()  $)P
  95.  
  96.    REPORTMAX := 20
  97.    REPORTCOUNT := 0
  98.  
  99.  
  100.  
  101. SOURCESTREAM := FINDINPUT("SYSIN")
  102. SELECTINPUT(SOURCESTREAM)
  103.  
  104. OCODE := FINDOUTPUT("OCODE")
  105. IF OCODE=0 DO OCODE := SYSPRINT
  106.  
  107. $(2 LET COMP(V, TREEMAX) BE
  108.     $(C LET B = VEC 63
  109.         CHBUF := B
  110.  
  111.       $(3 TREEP, TREEVEC := V+TREEMAX, V
  112.  
  113.         $( LET A = FORMTREE()
  114.            IF A=0 BREAK
  115.  
  116.            WRITEF("*NTREE SIZE %N*N", TREEMAX+TREEVEC-TREEP)
  117.  
  118.            IF OPTION!2 DO $( WRITES('AE TREE*N')
  119.                              PLIST(A, 0, 20)
  120.                              NEWLINE()  $)
  121.  
  122.  
  123.            UNLESS REPORTCOUNT=0 DO STOP(8)
  124.  
  125.            UNLESS OPTION!3 DO
  126.                   $( SELECTOUTPUT(OCODE)
  127.                      COMPILEAE(A)
  128.                      SELECTOUTPUT(SYSPRINT)  $)
  129.  
  130.       $)3 REPEAT
  131.     $)C
  132.  
  133.    APTOVEC(COMP, TREESIZE)
  134.  
  135.    ENDREAD()
  136.    IF OPTION!4 DO MAPSTORE()
  137.    WRITES('*NPHASE 1 COMPLETE*N')
  138.    UNLESS REPORTCOUNT=0 DO STOP(8)
  139.    FINISH   $)1
  140. .
  141.  
  142. //    LEX1
  143.  
  144.  
  145. GET "SYNHDR"
  146.  
  147. LET NEXTSYMB() BE
  148. $(1   NLPENDING := FALSE
  149.  
  150. NEXT: IF PPTRACE DO WRCH(CH)
  151.  
  152.     SWITCHON CH INTO
  153.  
  154.     $( CASE '*P':
  155.        CASE '*N': LINECOUNT := LINECOUNT + 1
  156.                   NLPENDING := TRUE  // IGNORABLE CHARACTERS
  157.        CASE '*T':
  158.        CASE '*S': RCH() REPEATWHILE CH='*S'
  159.                   GOTO NEXT
  160.  
  161.        CASE '0':CASE '1':CASE '2':CASE '3':CASE '4':
  162.        CASE '5':CASE '6':CASE '7':CASE '8':CASE '9':
  163.             SYMB := S.NUMBER
  164.             READNUMBER(10)
  165.             RETURN
  166.  
  167.        CASE 'A':CASE 'B':CASE 'C':CASE 'D':CASE 'E':
  168.        CASE 'F':CASE 'G':CASE 'H':CASE 'I':CASE 'J':
  169.        CASE 'K':CASE 'L':CASE 'M':CASE 'N':CASE 'O':
  170.        CASE 'P':CASE 'Q':CASE 'R':CASE 'S':CASE 'T':
  171.        CASE 'U':CASE 'V':CASE 'W':CASE 'X':CASE 'Y':
  172.        CASE 'Z':
  173.               RDTAG(CH)
  174.               SYMB := LOOKUPWORD()
  175.               IF SYMB=S.GET DO $( PERFORMGET(); GOTO NEXT  $)
  176.               RETURN
  177.  
  178.        CASE '$': RCH()
  179.                  UNLESS CH='(' \/ CH=')' DO CAEREPORT(91)
  180.                  SYMB := CH='(' -> S.LSECT, S.RSECT
  181.                  RDTAG('$')
  182.                  LOOKUPWORD()
  183.                  RETURN
  184.  
  185.        CASE '[':
  186.        CASE '(': SYMB := S.LPAREN; GOTO L
  187.        CASE ']':
  188.        CASE ')': SYMB := S.RPAREN; GOTO L
  189.  
  190.        CASE '#': SYMB := S.NUMBER
  191.                  RCH()
  192.                  IF '0'<=CH<='7' DO $( READNUMBER(8); RETURN  $)
  193.                  IF CH='B' DO $( RCH(); READNUMBER(2); RETURN  $)
  194.                  IF CH='O' DO $( RCH(); READNUMBER(8); RETURN  $)
  195.                  IF CH='X' DO $( RCH(); READNUMBER(16); RETURN  $)
  196.                  CAEREPORT(33)
  197.  
  198.        CASE '?': SYMB := S.QUERY; GOTO L
  199.        CASE '+': SYMB := S.PLUS; GOTO L
  200.        CASE ',': SYMB := S.COMMA; GOTO L
  201.        CASE ';': SYMB := S.SEMICOLON; GOTO L
  202.        CASE '@': SYMB := S.LV; GOTO L
  203.        CASE '&': SYMB := S.LOGAND; GOTO L
  204.        CASE '=': SYMB := S.EQ; GOTO L
  205.        CASE '!': SYMB := S.VECAP; GOTO L
  206.        CASE '_': SYMB := S.ASS; GOTO L
  207.        CASE '**': SYMB := S.MULT; GOTO L
  208.  
  209.        CASE '/': RCH()
  210.                  IF CH='\' DO $( SYMB := S.LOGAND; GOTO L $)
  211.                  IF CH='/' GOTO COMMENT
  212.                  UNLESS CH='**' DO $( SYMB := S.DIV; RETURN  $)
  213.  
  214.                  RCH()
  215.  
  216.                  UNTIL CH=ENDSTREAMCH DO TEST CH='**'
  217.  
  218.                        THEN $( RCH()
  219.                                UNLESS CH='/' LOOP
  220.                                RCH()
  221.                                GOTO NEXT  $)
  222.  
  223.                        OR $( IF CH='*N' DO LINECOUNT := LINECOUNT+1
  224.                              RCH()  $)
  225.  
  226.                  CAEREPORT(63)
  227.  
  228.  
  229.        COMMENT: RCH() REPEATUNTIL CH='*N' \/ CH=ENDSTREAMCH
  230.                 GOTO NEXT
  231.  
  232.        CASE '|': RCH()
  233.                  IF CH='|' GOTO COMMENT
  234.                  SYMB := S.LOGOR
  235.                  RETURN
  236.  
  237.        CASE '\': RCH()
  238.                  IF CH='/' DO $( SYMB := S.LOGOR; GOTO L  $)
  239.                  IF CH='=' DO $( SYMB := S.NE; GOTO L  $)
  240.                  SYMB := S.NOT
  241.                  RETURN
  242.  
  243.        CASE '<': RCH()
  244.                  IF CH='=' DO $( SYMB := S.LE; GOTO L  $)
  245.                  IF CH='<' DO $( SYMB := S.LSHIFT; GOTO L $)
  246.                  SYMB := S.LS
  247.                  RETURN
  248.  
  249.        CASE '>': RCH()
  250.                  IF CH='=' DO $( SYMB := S.GE; GOTO L  $)
  251.                  IF CH='>' DO $( SYMB := S.RSHIFT; GOTO L  $)
  252.                  SYMB := S.GR
  253.                  RETURN
  254.  
  255.        CASE '-': RCH()
  256.                  IF CH='>' DO $( SYMB := S.COND; GOTO L  $)
  257.                  SYMB := S.MINUS
  258.                  RETURN
  259.  
  260.        CASE ':': RCH()
  261.                  IF CH='=' DO $( SYMB := S.ASS; GOTO L  $)
  262.                  SYMB := S.COLON
  263.                  RETURN
  264.  
  265.         CASE '*'':CASE '*"':
  266.              $(1 LET QUOTE = CH
  267.                  CHARP := 0
  268.  
  269.               $( RCH()
  270.                  IF CH=QUOTE \/ CHARP=255 DO
  271.                         $( UNLESS CH=QUOTE DO CAEREPORT(95)
  272.                            IF CHARP=1 & CH='*'' DO
  273.                                    $( SYMB := S.NUMBER
  274.                                       DECVAL := CHARCODE(DECVAL)
  275.                                       GOTO L  $)
  276.                            CHARV!0 := CHARP
  277.                            WORDSIZE := PACKSTRING(CHARV, WORDV)
  278.                            SYMB := S.STRING
  279.                            GOTO L   $)
  280.  
  281.  
  282.                  IF CH='*N' DO LINECOUNT := LINECOUNT + 1
  283.  
  284.                  IF CH='**' DO
  285.                         $( RCH()
  286.                            IF CH='*N' DO
  287.                                $( LINECOUNT := LINECOUNT+1
  288.                                   RCH() REPEATWHILE CH='*S' \/ CH='*T'
  289.                                   UNLESS CH='**' DO CAEREPORT(34)
  290.                                   LOOP  $)
  291.                            IF CH='T' DO CH := '*T'
  292.                            IF CH='S' DO CH := '*S'
  293.                            IF CH='N' DO CH := '*N'
  294.                            IF CH='B' DO CH := '*B'
  295.                            IF CH='P' DO CH := '*P'  $)
  296.  
  297.                  DECVAL, CHARP := CH, CHARP+1
  298.                  CHARV!CHARP := CH  $) REPEAT  $)1
  299.  
  300.  
  301.  
  302.        DEFAULT: IF CH=ENDSTREAMCH DO
  303.        CASE '.':    $( IF GETP=0 DO
  304.                              $( SYMB := S.END
  305.                                 RETURN   $)
  306.  
  307.                        ENDREAD()
  308.                        GETP := GETP - 3
  309.                        SOURCESTREAM := GETV!GETP
  310.                        SELECTINPUT(SOURCESTREAM)
  311.                        LINECOUNT := GETV!(GETP+1)
  312.                        CH := GETV!(GETP+2)
  313.                        GOTO NEXT  $)
  314.  
  315.                    CH := '*S'
  316.                    CAEREPORT(94)
  317.                    RCH()
  318.                    GOTO NEXT
  319.  
  320.        L: RCH()   $)1
  321.  
  322. AND READNUMBER(RADIX) BE
  323.     $( LET D = VALUE(CH)
  324.        DECVAL := D
  325.        IF D>=RADIX DO CAEREPORT(33)
  326.  
  327.        $( RCH()
  328.           D := VALUE(CH)
  329.           IF D>=RADIX RETURN
  330.           DECVAL := RADIX*DECVAL + D  $) REPEAT
  331.     $)
  332.  
  333.  
  334. AND VALUE(CH) = '0'<=CH<='9' -> CH-'0',
  335.                 'A'<=CH<='F' -> CH-'A'+10,
  336.                 100
  337.  
  338. .
  339.  
  340. //    LEX2
  341.  
  342.  
  343. GET "SYNHDR"
  344.  
  345. LET D(S, ITEM) BE $( UNPACKSTRING(S, CHARV)
  346.                      WORDSIZE := PACKSTRING(CHARV, WORDV)
  347.                      LOOKUPWORD()
  348.                      WORDNODE!0 := ITEM  $)
  349.  
  350. AND DECLSYSWORDS() BE
  351.      $( D("AND", S.AND)
  352.  
  353.         D("BE", S.BE)
  354.         D("BREAK", S.BREAK)
  355.         D("BY", S.BY)
  356.  
  357.         D("CASE", S.CASE)
  358.  
  359.         D("DO", S.DO)
  360.         D("DEFAULT", S.DEFAULT)
  361.  
  362.         D("EQ", S.EQ)
  363.         D("EQV", S.EQV)
  364.         D("ELSE", S.OR)
  365.         D("ENDCASE", S.ENDCASE)
  366.  
  367.         D("FALSE", S.FALSE)
  368.         D("FOR", S.FOR)
  369.         D("FINISH", S.FINISH)
  370.  
  371.         D("GOTO", S.GOTO)
  372.         D("GE", S.GE)
  373.         D("GR", S.GR)
  374.         D("GLOBAL", S.GLOBAL)
  375.         D("GET", S.GET)
  376.  
  377.         D("IF", S.IF)
  378.         D("INTO", S.INTO)
  379.  
  380.         D("LET", S.LET)
  381.         D("LV", S.LV)
  382.         D("LE", S.LE)
  383.         D("LS", S.LS)
  384.         D("LOGOR", S.LOGOR)
  385.         D("LOGAND", S.LOGAND)
  386.         D("LOOP", S.LOOP)
  387.         D("LSHIFT", S.LSHIFT)
  388.  
  389.         D("MANIFEST", S.MANIFEST)
  390.  
  391.         D("NE", S.NE)
  392.         D("NOT", S.NOT)
  393.         D("NEQV", S.NEQV)
  394.  
  395.         D("OR", S.OR)
  396.  
  397.         D("RESULTIS", S.RESULTIS)
  398.         D("RETURN", S.RETURN)
  399.         D("REM", S.REM)
  400.         D("RSHIFT", S.RSHIFT)
  401.         D("RV", S.RV)
  402.         D("REPEAT", S.REPEAT)
  403.         D("REPEATWHILE", S.REPEATWHILE)
  404.         D("REPEATUNTIL", S.REPEATUNTIL)
  405.  
  406.         D("SWITCHON", S.SWITCHON)
  407.         D("STATIC", S.STATIC)
  408.  
  409.         D("TO", S.TO)
  410.         D("TEST", S.TEST)
  411.         D("TRUE", S.TRUE)
  412.         D("THEN", S.DO)
  413.         D("TABLE", S.TABLE)
  414.  
  415.         D("UNTIL", S.UNTIL)
  416.         D("UNLESS", S.UNLESS)
  417.  
  418.         D("VEC", S.VEC)
  419.         D("VALOF", S.VALOF)
  420.  
  421.         D("WHILE", S.WHILE)
  422.  
  423.         D("$", 0); NULLTAG := WORDNODE  $)
  424.  
  425. AND LOOKUPWORD() = VALOF
  426.  
  427. $(1     LET HASHVAL = (WORDV!0+WORDV!WORDSIZE >> 1) REM NAMETABLESIZE
  428.         LET M = @NAMETABLE!HASHVAL
  429.  
  430.   NEXT: WORDNODE := !M
  431.         UNLESS WORDNODE=0 DO
  432.              $(2 FOR I = 0 TO WORDSIZE DO
  433.                    IF WORDNODE!(I+2) NE WORDV!I DO
  434.                    $( M := WORDNODE+1
  435.                       GOTO NEXT  $)
  436.                  RESULTIS WORDNODE!0  $)2
  437.  
  438.         WORDNODE := NEWVEC(WORDSIZE+2)
  439.         WORDNODE!0, WORDNODE!1 := S.NAME, NAMETABLE!HASHVAL
  440.         FOR I = 0 TO WORDSIZE DO WORDNODE!(I+2) := WORDV!I
  441.         NAMETABLE!HASHVAL := WORDNODE
  442.         RESULTIS S.NAME
  443. $)1
  444.  
  445. .
  446.  
  447. //    LEX3
  448.  
  449.  
  450. GET "SYNHDR"
  451.  
  452. LET RCH() BE
  453.     $( CH := RDCH()
  454.  
  455.        IF PRSOURCE DO IF GETP=0 \/ CH NE ENDSTREAMCH DO
  456.           $( UNLESS LINECOUNT=PRLINE DO $( WRITEF("%I4  ", LINECOUNT)
  457.                                            PRLINE := LINECOUNT  $)
  458.              WRCH(CH)  $)
  459.  
  460.        CHCOUNT := CHCOUNT + 1
  461.        CHBUF!(CHCOUNT&63) := CH  $)
  462.  
  463. AND WRCHBUF() BE
  464.     $( WRITES("*N...")
  465.        FOR P = CHCOUNT-63 TO CHCOUNT DO
  466.                 $( LET K = CHBUF!(P&63)
  467.                    UNLESS K=0 DO WRCH(K)  $)
  468.        NEWLINE()  $)
  469.  
  470.  
  471. AND RDTAG(X) BE
  472.     $( CHARP, CHARV!1 := 1, X
  473.  
  474.         $(  RCH()
  475.             UNLESS 'A'<=CH<='Z' \/
  476.                    '0'<=CH<='9' \/
  477.                     CH='.' BREAK
  478.             CHARP := CHARP+1
  479.             CHARV!CHARP := CH  $) REPEAT
  480.  
  481.        CHARV!0 := CHARP
  482.        WORDSIZE := PACKSTRING(CHARV, WORDV)  $)
  483.  
  484.  
  485. AND PERFORMGET() BE
  486.     $( NEXTSYMB()
  487.        UNLESS SYMB=S.STRING THEN CAEREPORT(97)
  488.  
  489.        IF OPTION!5 RETURN
  490.  
  491.        GETV!GETP := SOURCESTREAM
  492.        GETV!(GETP+1) := LINECOUNT
  493.        GETV!(GETP+2) := CH
  494.        GETP := GETP + 3
  495.        LINECOUNT := 1
  496.        SOURCESTREAM := FINDINPUT(WORDV)
  497.        IF SOURCESTREAM=0 THEN CAEREPORT(96,WORDV)
  498.        SELECTINPUT(SOURCESTREAM)
  499.        RCH()   $)
  500.  
  501.  
  502. .
  503.  
  504. //    CAE0
  505.  
  506.  
  507. GET "SYNHDR"
  508.  
  509. LET NEWVEC(N) = VALOF
  510.     $( TREEP := TREEP - N - 1
  511.        IF TREEP<=TREEVEC DO
  512.                 $( REPORTMAX := 0
  513.                    CAEREPORT(98)  $)
  514.         RESULTIS TREEP  $)
  515.  
  516. AND LIST1(X) = VALOF
  517.     $( LET P = NEWVEC(0)
  518.        P!0 := X
  519.        RESULTIS P  $)
  520.  
  521. AND LIST2(X, Y) = VALOF
  522.      $( LET P = NEWVEC(1)
  523.         P!0, P!1 := X, Y
  524.         RESULTIS P   $)
  525.  
  526. AND LIST3(X, Y, Z) = VALOF
  527.      $( LET P = NEWVEC(2)
  528.         P!0, P!1, P!2 := X, Y, Z
  529.         RESULTIS P     $)
  530.  
  531. AND LIST4(X, Y, Z, T) = VALOF
  532.      $( LET P = NEWVEC(3)
  533.         P!0, P!1, P!2, P!3 := X, Y, Z, T
  534.         RESULTIS P   $)
  535.  
  536. AND LIST5(X, Y, Z, T, U) = VALOF
  537.      $( LET P = NEWVEC(4)
  538.         P!0, P!1, P!2, P!3, P!4 := X, Y, Z, T, U
  539.         RESULTIS P   $)
  540.  
  541. AND LIST6(X, Y, Z, T, U, V) = VALOF
  542.      $( LET P = NEWVEC(5)
  543.         P!0, P!1, P!2, P!3, P!4, P!5 := X, Y, Z, T, U, V
  544.         RESULTIS P  $)
  545.  
  546. AND CAEREPORT(N, A) BE
  547.      $( REPORTCOUNT := REPORTCOUNT + 1
  548.         WRITEF("*NSYNTAX ERROR NEAR LINE %N:  ", LINECOUNT)
  549.         CAEMESSAGE(N, A)
  550.         WRCHBUF()
  551.         IF REPORTCOUNT GR REPORTMAX DO
  552.                     $( WRITES('*NCOMPILATION ABORTED*N')
  553.                        STOP(8)   $)
  554.         NLPENDING := FALSE
  555.  
  556.         UNTIL SYMB=S.LSECT \/ SYMB=S.RSECT \/
  557.               SYMB=S.LET \/ SYMB=S.AND \/
  558.               SYMB=S.END \/ NLPENDING DO NEXTSYMB()
  559.         LONGJUMP(REC.P, REC.L)   $)
  560.  
  561. AND FORMTREE() =  VALOF
  562.     $(1 CHCOUNT := 0
  563.         FOR I = 0 TO 63 DO CHBUF!I := 0
  564.  
  565.      $( LET V = VEC 10   // FOR 'GET' STREAMS
  566.         GETV, GETP, GETT := V, 0, 10
  567.  
  568.      $( LET V = VEC 100
  569.         WORDV := V
  570.  
  571.      $( LET V = VEC 256
  572.         CHARV, CHARP := V, 0
  573.  
  574.      $( LET V = VEC 100
  575.         NAMETABLE, NAMETABLESIZE := V, 100
  576.         FOR I = 0 TO 100 DO NAMETABLE!I := 0
  577.  
  578.         REC.P, REC.L := LEVEL(), L
  579.  
  580.         LINECOUNT, PRLINE := 1, 0
  581.         RCH()
  582.  
  583.         IF CH=ENDSTREAMCH RESULTIS 0
  584.         DECLSYSWORDS()
  585.  
  586.      L: NEXTSYMB()
  587.  
  588.         IF OPTION!1 DO   //   PP DEBUGGING OPTION
  589.              $( WRITEF("%N %S*N", SYMB, WORDV)
  590.                 IF SYMB=S.END RESULTIS 0
  591.                 GOTO L  $)
  592.  
  593.      $( LET A = RDBLOCKBODY()
  594.         UNLESS SYMB=S.END DO $( CAEREPORT(99); GOTO L  $)
  595.  
  596.         RESULTIS A        $)1
  597.  
  598.  
  599.  
  600. AND CAEMESSAGE(N, A) BE
  601.     $( LET S = VALOF
  602.  
  603.          SWITCHON N INTO
  604.  
  605.          $( DEFAULT:  WRITEN(N); RETURN
  606.  
  607.             CASE 91: RESULTIS "'8'  '(' OR ')' EXPECTED"
  608.             CASE 94: RESULTIS "ILLEGAL CHARACTER"
  609.             CASE 95: RESULTIS "STRING TOO LONG"
  610.             CASE 96: RESULTIS "NO INPUT %S"
  611.             CASE 97: RESULTIS "STRING OR NUMBER EXPECTED"
  612.             CASE 98: RESULTIS "PROGRAM TOO LARGE"
  613.             CASE 99: RESULTIS "INCORRECT TERMINATION"
  614.  
  615.             CASE 8:CASE 40:CASE 43:
  616.                      RESULTIS "NAME EXPECTED"
  617.             CASE 6: RESULTIS "'$(' EXPECTED"
  618.             CASE 7: RESULTIS "'$)' EXPECTED"
  619.             CASE 9: RESULTIS "UNTAGGED '$)' MISMATCH"
  620.             CASE 32: RESULTIS "ERROR IN EXPRESSION"
  621.             CASE 33: RESULTIS "ERROR IN NUMBER"
  622.             CASE 34: RESULTIS "BAD STRING"
  623.             CASE 15:CASE 19:CASE 41: RESULTIS "')' MISSING"
  624.             CASE 30: RESULTIS "',' MISSING"
  625.             CASE 42: RESULTIS "'=' OR 'BE' EXPECTED"
  626.             CASE 44: RESULTIS "'=' OR '(' EXPECTED"
  627.             CASE 50: RESULTIS "ERROR IN LABEL"
  628.             CASE 51: RESULTIS "ERROR IN COMMAND"
  629.             CASE 54: RESULTIS "'OR' EXPECTED"
  630.             CASE 57: RESULTIS "'=' EXPECTED"
  631.             CASE 58: RESULTIS "'TO' EXPECTED"
  632.             CASE 60: RESULTIS "'INTO' EXPECTED"
  633.             CASE 61:CASE 62: RESULTIS "':' EXPECTED"
  634.             CASE 63: RESULTIS "'**/' MISSING"
  635.                        $)
  636.  
  637.          WRITEF(S, A)  $)
  638.  
  639.  
  640. .
  641.  
  642. //    CAE1
  643.  
  644.  
  645. GET "SYNHDR"
  646.  
  647. LET RDBLOCKBODY() = VALOF
  648.     $(1 LET P, L = REC.P, REC.L
  649.         LET A = 0
  650.  
  651.         REC.P, REC.L := LEVEL(), RECOVER
  652.  
  653.         IGNORE(S.SEMICOLON)
  654.  
  655.         SWITCHON SYMB INTO
  656.      $( CASE S.MANIFEST:
  657.         CASE S.STATIC:
  658.         CASE S.GLOBAL:
  659.             $(  LET OP = SYMB
  660.                 NEXTSYMB()
  661.                 A := RDSECT(RDCDEFS)
  662.                 A := LIST3(OP, A, RDBLOCKBODY())
  663.                 GOTO RET  $)
  664.  
  665.  
  666.         CASE S.LET: NEXTSYMB()
  667.                     A := RDEF()
  668.            RECOVER: WHILE SYMB=S.AND DO
  669.                           $( NEXTSYMB()
  670.                              A := LIST3(S.AND, A, RDEF())  $)
  671.                     A := LIST3(S.LET, A, RDBLOCKBODY())
  672.                     GOTO RET
  673.  
  674.         DEFAULT: A := RDSEQ()
  675.  
  676.                  UNLESS SYMB=S.RSECT \/ SYMB=S.END DO
  677.                           CAEREPORT(51)
  678.  
  679.         CASE S.RSECT: CASE S.END:
  680.         RET:   REC.P, REC.L := P, L
  681.                RESULTIS A   $)1
  682.  
  683. AND RDSEQ() = VALOF
  684.     $( LET A = 0
  685.        IGNORE(S.SEMICOLON)
  686.        A := RCOM()
  687.        IF SYMB=S.RSECT \/ SYMB=S.END RESULTIS A
  688.        RESULTIS LIST3(S.SEQ, A, RDSEQ())   $)
  689.  
  690.  
  691. AND RDCDEFS() = VALOF
  692.     $(1 LET A, B = 0, 0
  693.         LET PTR = @A
  694.         LET P, L = REC.P, REC.L
  695.         REC.P, REC.L := LEVEL(), RECOVER
  696.  
  697.         $( B := RNAME()
  698.            TEST SYMB=S.EQ \/ SYMB=S.COLON THEN NEXTSYMB()
  699.                                             OR CAEREPORT(45)
  700.            !PTR := LIST4(S.CONSTDEF, 0, B, REXP(0))
  701.            PTR := @H2!(!PTR)
  702.   RECOVER: IGNORE(S.SEMICOLON) $) REPEATWHILE SYMB=S.NAME
  703.  
  704.         REC.P, REC.L := P, L
  705.         RESULTIS A  $)1
  706.  
  707. AND RDSECT(R) = VALOF
  708.     $(  LET TAG, A = WORDNODE, 0
  709.         CHECKFOR(S.LSECT, 6)
  710.         A := R()
  711.         UNLESS SYMB=S.RSECT DO CAEREPORT(7)
  712.         TEST TAG=WORDNODE
  713.              THEN NEXTSYMB()
  714.                OR IF WORDNODE=NULLTAG DO
  715.                       $( SYMB := 0
  716.                          CAEREPORT(9)  $)
  717.         RESULTIS A   $)
  718.  
  719.  
  720. AND RNAMELIST() = VALOF
  721.     $(  LET A = RNAME()
  722.         UNLESS SYMB=S.COMMA RESULTIS A
  723.         NEXTSYMB()
  724.         RESULTIS LIST3(S.COMMA, A, RNAMELIST())   $)
  725.  
  726.  
  727. AND RNAME() = VALOF
  728.     $( LET A = WORDNODE
  729.        CHECKFOR(S.NAME, 8)
  730.        RESULTIS A  $)
  731.  
  732. AND IGNORE(ITEM) BE IF SYMB=ITEM DO NEXTSYMB()
  733.  
  734. AND CHECKFOR(ITEM, N) BE
  735.       $( UNLESS SYMB=ITEM DO CAEREPORT(N)
  736.          NEXTSYMB()  $)
  737.  
  738. .
  739.  
  740. //    CAE2
  741.  
  742. GET "SYNHDR"
  743.  
  744. LET RBEXP() = VALOF
  745.   $(1   LET A, OP = 0, SYMB
  746.  
  747.         SWITCHON SYMB INTO
  748.  
  749.     $(  DEFAULT:
  750.             CAEREPORT(32)
  751.  
  752.         CASE S.QUERY:
  753.             NEXTSYMB(); RESULTIS LIST1(S.QUERY)
  754.  
  755.         CASE S.TRUE:
  756.         CASE S.FALSE:
  757.         CASE S.NAME:
  758.             A := WORDNODE
  759.             NEXTSYMB()
  760.             RESULTIS A
  761.  
  762.         CASE S.STRING:
  763.             A := NEWVEC(WORDSIZE+1)
  764.             A!0 := S.STRING
  765.             FOR I = 0 TO WORDSIZE DO A!(I+1) := WORDV!I
  766.             NEXTSYMB()
  767.             RESULTIS A
  768.  
  769.         CASE S.NUMBER:
  770.             A := LIST2(S.NUMBER, DECVAL)
  771.             NEXTSYMB()
  772.             RESULTIS A
  773.  
  774.         CASE S.LPAREN:
  775.             NEXTSYMB()
  776.             A := REXP(0)
  777.             CHECKFOR(S.RPAREN, 15)
  778.             RESULTIS A
  779.  
  780.         CASE S.VALOF:
  781.             NEXTSYMB()
  782.             RESULTIS LIST2(S.VALOF, RCOM())
  783.  
  784.         CASE S.VECAP: OP := S.RV
  785.         CASE S.LV:
  786.         CASE S.RV: NEXTSYMB(); RESULTIS LIST2(OP, REXP(35))
  787.  
  788.         CASE S.PLUS: NEXTSYMB(); RESULTIS REXP(34)
  789.  
  790.         CASE S.MINUS: NEXTSYMB()
  791.                       A := REXP(34)
  792.                       TEST H1!A=S.NUMBER
  793.                           THEN H2!A := - H2!A
  794.                             OR A := LIST2(S.NEG, A)
  795.                       RESULTIS A
  796.  
  797.         CASE S.NOT: NEXTSYMB(); RESULTIS LIST2(S.NOT, REXP(24))
  798.  
  799.         CASE S.TABLE: NEXTSYMB()
  800.                       RESULTIS LIST2(S.TABLE, REXPLIST())   $)1
  801.  
  802.  
  803.  
  804. AND REXP(N) = VALOF
  805.     $(1 LET A = RBEXP()
  806.  
  807.         LET B, C, P, Q = 0, 0, 0, 0
  808.  
  809.   L: $( LET OP = SYMB
  810.  
  811.         IF NLPENDING RESULTIS A
  812.  
  813.         SWITCHON OP INTO
  814.     $(B DEFAULT: RESULTIS A
  815.  
  816.         CASE S.LPAREN: NEXTSYMB()
  817.                        B := 0
  818.                        UNLESS SYMB=S.RPAREN DO B := REXPLIST()
  819.                        CHECKFOR(S.RPAREN, 19)
  820.                        A := LIST3(S.FNAP, A, B)
  821.                        GOTO L
  822.  
  823.         CASE S.VECAP: P := 40; GOTO LASSOC
  824.  
  825.         CASE S.REM:CASE S.MULT:CASE S.DIV: P := 35; GOTO LASSOC
  826.  
  827.         CASE S.PLUS:CASE S.MINUS: P := 34; GOTO LASSOC
  828.  
  829.         CASE S.EQ:CASE S.NE:
  830.         CASE S.LE:CASE S.GE:
  831.         CASE S.LS:CASE S.GR:
  832.                 IF N>=30 RESULTIS A
  833.  
  834.             $(R NEXTSYMB()
  835.                 B := REXP(30)
  836.                 A := LIST3(OP, A, B)
  837.                 TEST C=0 THEN C :=  A
  838.                            OR C := LIST3(S.LOGAND, C, A)
  839.                 A, OP := B, SYMB  $)R REPEATWHILE S.EQ<=OP<=S.GE
  840.  
  841.                 A := C
  842.                 GOTO L
  843.  
  844.         CASE S.LSHIFT:CASE S.RSHIFT: P, Q := 25, 30; GOTO DIADIC
  845.  
  846.         CASE S.LOGAND: P := 23; GOTO LASSOC
  847.  
  848.         CASE S.LOGOR: P := 22; GOTO LASSOC
  849.  
  850.         CASE S.EQV:CASE S.NEQV: P := 21; GOTO LASSOC
  851.  
  852.         CASE S.COND:
  853.                 IF N>=13 RESULTIS A
  854.                 NEXTSYMB()
  855.                 B := REXP(0)
  856.                 CHECKFOR(S.COMMA, 30)
  857.                 A := LIST4(S.COND, A, B, REXP(0))
  858.                 GOTO L
  859.  
  860.         LASSOC: Q := P
  861.  
  862.         DIADIC: IF N>=P RESULTIS A
  863.                 NEXTSYMB()
  864.                 A := LIST3(OP, A, REXP(Q))
  865.                 GOTO L                     $)B     $)1
  866.  
  867. LET REXPLIST() = VALOF
  868.     $(1 LET A = 0
  869.         LET PTR = @A
  870.  
  871.      $( LET B = REXP(0)
  872.         UNLESS SYMB=S.COMMA DO $( !PTR := B
  873.                                   RESULTIS A  $)
  874.         NEXTSYMB()
  875.         !PTR := LIST3(S.COMMA, B, 0)
  876.         PTR := @H3!(!PTR)  $) REPEAT
  877.     $)1
  878.  
  879. LET RDEF() = VALOF
  880.     $(1 LET N = RNAMELIST()
  881.  
  882.         SWITCHON SYMB INTO
  883.  
  884.      $( CASE S.LPAREN:
  885.              $( LET A = 0
  886.                 NEXTSYMB()
  887.                 UNLESS H1!N=S.NAME DO CAEREPORT(40)
  888.                 IF SYMB=S.NAME DO A := RNAMELIST()
  889.                 CHECKFOR(S.RPAREN, 41)
  890.  
  891.                 IF SYMB=S.BE DO
  892.                      $( NEXTSYMB()
  893.                         RESULTIS LIST5(S.RTDEF, N, A, RCOM(), 0)  $)
  894.  
  895.                 IF SYMB=S.EQ DO
  896.                      $( NEXTSYMB()
  897.                         RESULTIS LIST5(S.FNDEF, N, A, REXP(0), 0)  $)
  898.  
  899.                 CAEREPORT(42)  $)
  900.  
  901.         DEFAULT: CAEREPORT(44)
  902.  
  903.         CASE S.EQ:
  904.                 NEXTSYMB()
  905.                 IF SYMB=S.VEC DO
  906.                      $( NEXTSYMB()
  907.                         UNLESS H1!N=S.NAME DO CAEREPORT(43)
  908.                         RESULTIS LIST3(S.VECDEF, N, REXP(0))  $)
  909.                 RESULTIS LIST3(S.VALDEF, N, REXPLIST())  $)1
  910.  
  911. .
  912.  
  913.  
  914. //    CAE4
  915.  
  916. GET "SYNHDR"
  917.  
  918. LET RBCOM() = VALOF
  919.    $(1 LET A, B, OP = 0, 0, SYMB
  920.  
  921.         SWITCHON SYMB INTO
  922.      $( DEFAULT: RESULTIS 0
  923.  
  924.         CASE S.NAME:CASE S.NUMBER:CASE S.STRING:
  925.         CASE S.TRUE:CASE S.FALSE:CASE S.LV:CASE S.RV:CASE S.VECAP:
  926.         CASE S.LPAREN:
  927.                 A := REXPLIST()
  928.  
  929.                 IF SYMB=S.ASS  THEN
  930.                     $(  OP := SYMB
  931.                         NEXTSYMB()
  932.                         RESULTIS LIST3(OP, A, REXPLIST())  $)
  933.  
  934.                 IF SYMB=S.COLON DO
  935.                      $( UNLESS H1!A=S.NAME DO CAEREPORT(50)
  936.                         NEXTSYMB()
  937.                         RESULTIS LIST4(S.COLON, A, RBCOM(), 0)  $)
  938.  
  939.                 IF H1!A=S.FNAP DO
  940.                      $( H1!A := S.RTAP
  941.                         RESULTIS A  $)
  942.  
  943.                 CAEREPORT(51)
  944.                 RESULTIS A
  945.  
  946.         CASE S.GOTO:CASE S.RESULTIS:
  947.                 NEXTSYMB()
  948.                 RESULTIS LIST2(OP, REXP(0))
  949.  
  950.         CASE S.IF:CASE S.UNLESS:
  951.         CASE S.WHILE:CASE S.UNTIL:
  952.                 NEXTSYMB()
  953.                 A := REXP(0)
  954.                 IGNORE(S.DO)
  955.                 RESULTIS LIST3(OP, A, RCOM())
  956.  
  957.         CASE S.TEST:
  958.                 NEXTSYMB()
  959.                 A := REXP(0)
  960.                 IGNORE(S.DO)
  961.                 B := RCOM()
  962.                 CHECKFOR(S.OR, 54)
  963.                 RESULTIS LIST4(S.TEST, A, B, RCOM())
  964.  
  965.         CASE S.FOR:
  966.             $(  LET I, J, K = 0, 0, 0
  967.                 NEXTSYMB()
  968.                 A := RNAME()
  969.                 CHECKFOR(S.EQ, 57)
  970.                 I := REXP(0)
  971.                 CHECKFOR(S.TO, 58)
  972.                 J := REXP(0)
  973.                 IF SYMB=S.BY DO $( NEXTSYMB()
  974.                                    K := REXP(0)  $)
  975.                 IGNORE(S.DO)
  976.                 RESULTIS LIST6(S.FOR, A, I, J, K, RCOM())  $)
  977.  
  978.         CASE S.LOOP:
  979.         CASE S.BREAK:CASE S.RETURN:CASE S.FINISH:CASE S.ENDCASE:
  980.                 A := WORDNODE
  981.                 NEXTSYMB()
  982.                 RESULTIS A
  983.  
  984.         CASE S.SWITCHON:
  985.                 NEXTSYMB()
  986.                 A := REXP(0)
  987.                 CHECKFOR(S.INTO, 60)
  988.                 RESULTIS LIST3(S.SWITCHON, A, RDSECT(RDSEQ))
  989.  
  990.         CASE S.CASE:
  991.                 NEXTSYMB()
  992.                 A := REXP(0)
  993.                 CHECKFOR(S.COLON, 61)
  994.                 RESULTIS LIST3(S.CASE, A, RBCOM())
  995.  
  996.         CASE S.DEFAULT:
  997.                 NEXTSYMB()
  998.                 CHECKFOR(S.COLON, 62)
  999.                 RESULTIS LIST2(S.DEFAULT, RBCOM())
  1000.  
  1001.         CASE S.LSECT:
  1002.                 RESULTIS RDSECT(RDBLOCKBODY)   $)1
  1003.  
  1004.  
  1005. AND RCOM() = VALOF
  1006.     $(1 LET A = RBCOM()
  1007.  
  1008.         IF A=0 DO CAEREPORT(51)
  1009.  
  1010.         WHILE SYMB=S.REPEAT \/ SYMB=S.REPEATWHILE \/
  1011.                     SYMB=S.REPEATUNTIL DO
  1012.                   $( LET OP = SYMB
  1013.                      NEXTSYMB()
  1014.                      TEST OP=S.REPEAT
  1015.                          THEN A := LIST2(OP, A)
  1016.                            OR A := LIST3(OP, A, REXP(0))   $)
  1017.  
  1018.         RESULTIS A  $)1
  1019.  
  1020. .
  1021.  
  1022. //    PLIST
  1023.  
  1024. GET "SYNHDR"
  1025.  
  1026. LET PLIST(X, N, D) BE
  1027.     $(1 LET SIZE = 0
  1028.         LET V = TABLE 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  1029.  
  1030.         IF X=0 DO $( WRITES("NIL"); RETURN  $)
  1031.  
  1032.         SWITCHON H1!X INTO
  1033.     $(  CASE S.NUMBER: WRITEN(H2!X); RETURN
  1034.  
  1035.         CASE S.NAME: WRITES(X+2); RETURN
  1036.  
  1037.         CASE S.STRING: WRITEF("*"%S*"", X+1); RETURN
  1038.  
  1039.         CASE S.FOR:
  1040.                 SIZE := SIZE + 2
  1041.  
  1042.         CASE S.COND:CASE S.FNDEF:CASE S.RTDEF:
  1043.         CASE S.TEST:CASE S.CONSTDEF:
  1044.                 SIZE := SIZE + 1
  1045.  
  1046.         CASE S.VECAP:CASE S.FNAP:
  1047.         CASE S.MULT:CASE S.DIV:CASE S.REM:CASE S.PLUS:CASE S.MINUS:
  1048.         CASE S.EQ:CASE S.NE:CASE S.LS:CASE S.GR:CASE S.LE:CASE S.GE:
  1049.         CASE S.LSHIFT:CASE S.RSHIFT:CASE S.LOGAND:CASE S.LOGOR:
  1050.         CASE S.EQV:CASE S.NEQV:CASE S.COMMA:
  1051.         CASE S.AND:CASE S.VALDEF:CASE S.VECDEF:
  1052.         CASE S.ASS:CASE S.RTAP:CASE S.COLON:CASE S.IF:CASE S.UNLESS:
  1053.         CASE S.WHILE:CASE S.UNTIL:CASE S.REPEATWHILE:
  1054.         CASE S.REPEATUNTIL:
  1055.         CASE S.SWITCHON:CASE S.CASE:CASE S.SEQ:CASE S.LET:
  1056.         CASE S.MANIFEST:CASE S.STATIC:CASE S.GLOBAL:
  1057.                 SIZE := SIZE + 1
  1058.  
  1059.         CASE S.VALOF:CASE S.LV:CASE S.RV:CASE S.NEG:CASE S.NOT:
  1060.         CASE S.TABLE:CASE S.GOTO:CASE S.RESULTIS:CASE S.REPEAT:
  1061.         CASE S.DEFAULT:
  1062.                 SIZE := SIZE + 1
  1063.  
  1064.         CASE S.LOOP:
  1065.         CASE S.BREAK:CASE S.RETURN:CASE S.FINISH:CASE S.ENDCASE:
  1066.         CASE S.TRUE:CASE S.FALSE:CASE S.QUERY:
  1067.         DEFAULT:
  1068.                 SIZE := SIZE + 1
  1069.  
  1070.                 IF N=D DO $( WRITES("ETC")
  1071.                              RETURN  $)
  1072.  
  1073.                 WRITES ("OP")
  1074.                 WRITEN(H1!X)
  1075.                 FOR I = 2 TO SIZE DO
  1076.                      $( NEWLINE()
  1077.                         FOR J=0 TO N-1 DO WRITES( V!J )
  1078.                         WRITES("**-")
  1079.                         V!N := I=SIZE->"  ","! "
  1080.                         PLIST(H1!(X+I-1), N+1, D)  $)
  1081.                 RETURN  $)1
  1082.  
  1083.